home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / 4dos / 4utilsf.zip / STRINGDA.PAS < prev   
Pascal/Delphi Source File  |  1992-12-10  |  14KB  |  565 lines
  1. UNIT StringDateHandling;
  2. {$D-,F+} (* I'am using procedural variables! *)
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992 Copyright by David Frey,
  8.                          Urdorferstrasse 30
  9.                          8952 Schlieren ZH
  10.                          Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the string handling and the date/time handling.
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Dos;
  33.  
  34. TYPE  DateStr = STRING[8]; (* 'mm-dd-yy','dd.mm.yy' or 'yy/mm/dd' *)
  35.       TimeStr = STRING[6]; (* 'hh:mmp' or 'hh:mm'                 *)
  36.  
  37. VAR   DateFormat: DateStr; (* 'mm-dd-yy','dd.mm.yy','yy/mm/dd' or 'ddmmmyy' *)
  38.       TimeFormat: TimeStr; (* 'hh:mmp' or 'hh:mm'                           *)
  39.  
  40. (* String handling routines. The strings can be converted to lower/upper-
  41.    case. National characters will be converted.                           *)
  42.  
  43. FUNCTION  Chars(c: CHAR; Count: BYTE): STRING;
  44. FUNCTION  DownCase(C: CHAR): CHAR;
  45. FUNCTION  DownStr(s: STRING): STRING;
  46. PROCEDURE DownString(VAR s: STRING);
  47. FUNCTION  UpStr(s: STRING): STRING;
  48. PROCEDURE UpString(VAR s: STRING);
  49.  
  50. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  51. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  52.  
  53. (* Date/Time handling routines. Date/Time and Numbers will be formatted
  54.    in accordance with your COUNTRY=-settings in CONFIG.SYS.               *)
  55.  
  56. TYPE  FormDateFunc = FUNCTION (DateRec: DateTime) : DateStr;
  57.       FormTimeFunc = FUNCTION (DateRec: DateTime) : TimeStr;
  58.  
  59. VAR   FormDate : FormDateFunc;
  60.       FormTime : FormTimeFunc;
  61.  
  62.  
  63. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  64. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  65.  
  66. IMPLEMENTATION USES HandleINIFile;
  67.  
  68. CONST MonthName: ARRAY[1..12] OF STRING[3] =
  69.                   ('Jan','Feb','Mar','Apr','May','Jun',
  70.                    'Jul','Aug','Sep','Oct','Nov','Dec');
  71.  
  72. CONST DateSep  : CHAR = '.';
  73.       TimeSep  : CHAR = ':';
  74.       MilleSep : CHAR = '''';
  75.  
  76. VAR   Buffer: ARRAY[0..15] OF CHAR;
  77.       (* Buffer for country code information.
  78.          This buffer may not be moved into GetCountryInfo,
  79.          since MS-DOS needs the address of this buffer!    *)
  80.  
  81. (*-------------------------------------------------------- String-Handling *)
  82. FUNCTION Chars(c: CHAR; Count: BYTE): STRING; ASSEMBLER;
  83.  
  84. ASM
  85.  LES DI,@Result
  86.  MOV AL,&Count
  87.  CLD
  88.  STOSB
  89.  MOV CL,AL
  90.  XOR CH,CH
  91.  MOV AL,&c
  92.  REP STOSB
  93. END;
  94.  
  95. FUNCTION  DownCase(C: CHAR): CHAR; ASSEMBLER;
  96.  
  97. ASM
  98.   MOV AL,&c
  99.   CMP AL,'A'
  100.   JB  @@9                  (* No conversion below 'A'                     *)
  101.   CMP AL,'Z'
  102.   JA  @@1                  (* Conversion between 'A' and 'Z'              *)
  103.   ADD AL,$20
  104.   JMP @@9                  (* finished. *)
  105. @@1: CMP AL,'Ä'
  106.   JNZ @@2
  107.   MOV AL,'ä'
  108.   JMP @@9
  109. @@2:
  110.   CMP AL,'Ö'
  111.   JNZ @@3
  112.   MOV AL,'ö'
  113.   JMP @@9
  114. @@3:
  115.   CMP AL,'Ü'
  116.   JNZ @@4                  (* No conversion at all                        *)
  117.   MOV AL,'ü'
  118.   JMP @@9
  119. @@4:
  120.   CMP AL,'É'
  121.   JNZ @@5
  122.   MOV AL,'é'
  123.   JMP @@9
  124. @@5:
  125.   CMP AL,'Ç'
  126.   JNZ @@6
  127.   MOV AL,'ç'
  128.   JMP @@9
  129. @@6:
  130.   CMP AL,'Å'
  131.   JNZ @@7
  132.   MOV AL,'å'
  133.   JMP @@9
  134. @@7:
  135.   CMP AL,'Ñ'
  136.   JNZ @@9                  (* No conversion at all *)
  137.   MOV AL,'ñ'
  138. @@9:
  139. END;
  140.  
  141. FUNCTION  DownStr(s: STRING): STRING; ASSEMBLER;
  142.  
  143. ASM
  144.  PUSH DS
  145.  CLD
  146.  LDS SI,s
  147.  LES DI,@Result
  148.  LODSB
  149.  STOSB
  150.  XOR AH,AH
  151.  XCHG AX,CX
  152.  JCXZ @11
  153. @10:
  154.  LODSB
  155.  CMP AL,'A'
  156.  JB  @@9                  (* No conversion below 'A'                     *)
  157.  CMP AL,'Z'
  158.  JA  @@1                  (* Conversion between 'A' and 'Z'              *)
  159.  ADD AL,$20
  160.  JMP @@9                  (* finished. *)
  161. @@1: CMP AL,'Ä'
  162.  JNZ @@2
  163.  MOV AL,'ä'
  164.  JMP @@9
  165. @@2:
  166.  CMP AL,'Ö'
  167.  JNZ @@3
  168.  MOV AL,'ö'
  169.  JMP @@9
  170. @@3:
  171.  CMP AL,'Ü'
  172.  JNZ @@4
  173.  MOV AL,'ü'
  174.  JMP @@9
  175. @@4:
  176.  CMP AL,'É'
  177.  JNZ @@5
  178.  MOV AL,'é'
  179.  JMP @@9
  180. @@5:
  181.  CMP AL,'Ç'
  182.  JNZ @@6
  183.  MOV AL,'ç'
  184.  JMP @@9
  185. @@6:
  186.  CMP AL,'Å'
  187.  JNZ @@7
  188.  MOV AL,'å'
  189.  JMP @@9
  190. @@7:
  191.  CMP AL,'Ñ'
  192.  JNZ @@9                  (* No conversion at all                        *)
  193.  MOV AL,'ñ'
  194. @@9:
  195.  STOSB
  196.  LOOP @10
  197. @11:
  198.  POP DS
  199. END;
  200.  
  201.  
  202. PROCEDURE DownString(VAR s: STRING);
  203.  
  204. VAR i : BYTE;
  205.  
  206. BEGIN
  207.  FOR i := 1 TO Length(s) DO s[i] := DownCase(s[i]);
  208. END;
  209.  
  210.  
  211. FUNCTION  UpStr(s: STRING): STRING; ASSEMBLER;
  212.  
  213. ASM
  214.  PUSH DS
  215.  CLD
  216.  LDS SI,s
  217.  LES DI,@Result
  218.  LODSB
  219.  STOSB
  220.  XOR AH,AH
  221.  XCHG AX,CX
  222.  JCXZ @11
  223. @10:
  224.  LODSB
  225.  CMP AL,'a'
  226.  JB @@9
  227.  CMP AL,'z'
  228.  JA @@1
  229.  SUB AL,20H
  230.  JMP @@9
  231. @@1: CMP AL,'ä'
  232.   JNZ @@2
  233.   MOV AL,'Ä'
  234.   JMP @@9
  235. @@2:
  236.   CMP AL,'ö'
  237.   JNZ @@3
  238.   MOV AL,'Ö'
  239.   JMP @@9
  240. @@3:
  241.   CMP AL,'ü'
  242.   JNZ @@4
  243.   MOV AL,'Ü'
  244.   JMP @@9
  245. @@4:
  246.   CMP AL,'é'
  247.   JNZ @@5
  248.   MOV AL,'É'
  249.   JMP @@9
  250. @@5:
  251.   CMP AL,'ç'
  252.   JNZ @@6
  253.   MOV AL,'Ç'
  254.   JMP @@9
  255. @@6:
  256.   CMP AL,'å'
  257.   JNZ @@7
  258.   MOV AL,'Å'
  259.   JMP @@9
  260. @@7:
  261.   CMP AL,'ñ'
  262.   JNZ @@9                  (* No conversion at all                        *)
  263.   MOV AL,'Ñ'
  264. @@9:
  265.  STOSB
  266.  LOOP @10
  267. @11:
  268.  POP DS
  269. END;
  270.  
  271. PROCEDURE UpString(VAR s: STRING);
  272.  
  273. VAR l : BYTE;
  274.  
  275. BEGIN
  276.  FOR l := 1 TO Length(s) DO s[l] := UpCase(s[l]);
  277. END;
  278.  
  279. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  280.  
  281. BEGIN
  282.  WHILE s[1] = ' ' DO Delete(s,1,1);
  283. END;
  284.  
  285. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  286.  
  287. VAR l : BYTE;
  288.  
  289. BEGIN
  290.  l := Length(s);
  291.  WHILE s[l] = ' ' DO BEGIN Delete(s,l,1); l := Length(s); END;
  292. END;
  293.  
  294. (*-------------------------------------------------------- Date-Handling *)
  295.  
  296. FUNCTION FormDateEuropean(DateRec: DateTime): DateStr;
  297.  
  298. VAR MonStr, DayStr, YearStr : STRING[2];
  299.     res                     : DateStr;
  300.  
  301. BEGIN
  302.  Str(DateRec.Day:2, DayStr);
  303.  
  304.  Str(DateRec.Month:2, MonStr);
  305.  IF DateRec.Month < 10 THEN MonStr[1] := '0';
  306.  
  307.  DateRec.Year := DateRec.Year MOD 100;
  308.  Str(DateRec.Year:2, YearStr);
  309.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  310.  
  311.  FormDateEuropean := DayStr + DateSep + MonStr + DateSep + YearStr;
  312. END;
  313.  
  314. FUNCTION FormDateUS(DateRec: DateTime): DateStr;
  315.  
  316. VAR MonStr, DayStr, YearStr : STRING[2];
  317.     res                     : DateStr;
  318.  
  319. BEGIN
  320.  Str(DateRec.Day:2, DayStr);
  321.  IF DateRec.Day < 10 THEN DayStr[1] := '0';
  322.  
  323.  Str(DateRec.Month:2, MonStr);
  324.  
  325.  DateRec.Year := DateRec.Year MOD 100;
  326.  Str(DateRec.Year:2, YearStr);
  327.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  328.  
  329.  FormDateUS := MonStr + DateSep + DayStr + DateSep + YearStr;
  330. END;
  331.  
  332. FUNCTION FormDateJapanese(DateRec: DateTime): DateStr;
  333.  
  334. VAR MonStr, DayStr, YearStr : STRING[2];
  335.     res                     : DateStr;
  336.  
  337. BEGIN
  338.  Str(DateRec.Day:2, DayStr);
  339.  IF (DateRec.Day < 10) THEN DayStr[1] := '0';
  340.  
  341.  Str(DateRec.Month:2, MonStr);
  342.  IF (DateRec.Month < 10) THEN MonStr[1] := '0';
  343.  
  344.  DateRec.Year := DateRec.Year MOD 100;
  345.  Str(DateRec.Year:2, YearStr);
  346.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  347.  
  348.  FormDateJapanese := YearStr + DateSep + MonStr + DateSep + DayStr;
  349. END;
  350.  
  351. FUNCTION FormDateMyOwn(DateRec: DateTime): DateStr;
  352.  
  353. VAR DayStr, YearStr : STRING[2];
  354.     res             : DateStr;
  355.  
  356. BEGIN
  357.  Str(DateRec.Day:2, DayStr);
  358.  
  359.  DateRec.Year := DateRec.Year MOD 100;
  360.  Str(DateRec.Year:2, YearStr);
  361.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  362.  
  363.  FormDateMyOwn := DayStr + MonthName[DateRec.Month] + YearStr;
  364. END;
  365.  
  366. FUNCTION FormTime12(DateRec: DateTime): TimeStr;
  367.  
  368. VAR HourStr, MinStr, SecStr : STRING[2];
  369.     amflag                  : CHAR;
  370.     res                     : TimeStr;
  371.  
  372. BEGIN
  373.  IF DateRec.Hour < 12 THEN amflag := 'a'
  374.                       ELSE BEGIN amflag := 'p'; DEC(DateRec.Hour,12); END;
  375.  Str(DateRec.Hour:2,HourStr);
  376.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  377.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  378.  
  379.  FormTime12 := HourStr + TimeSep + MinStr + amflag;
  380. END;
  381.  
  382. FUNCTION FormTime24(DateRec: DateTime): TimeStr;
  383.  
  384. VAR HourStr, MinStr, SecStr : STRING[2];
  385.     res                     : TimeStr;
  386.  
  387. BEGIN
  388.  Str(DateRec.Hour:2,HourStr);
  389.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  390.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  391.  
  392.  FormTime24 := HourStr + TimeSep + MinStr;
  393. END;
  394.  
  395. (*------------------------------------------------ Formatting of numbers *)
  396.  
  397. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  398. (* Converts an integer number into a string of the form xxx'xxx...') *)
  399.  
  400. VAR helpstr  : STRING;
  401.     millestr : STRING[4];
  402.     n,i      : BYTE;
  403.  
  404. BEGIN
  405.  IF nr = 0 THEN FormattedIntStr := Chars(' ',minlength-1)+'0'
  406.  ELSE
  407.   BEGIN
  408.    helpstr := '';
  409.    n := nr DIV 1000; nr := nr MOD 1000;
  410.    IF n > 0 THEN
  411.     BEGIN
  412.      Str(n,helpstr);
  413.      helpstr := millestr+helpstr+MilleSep;
  414.     END;
  415.  
  416.    IF n = 0 THEN Str(nr,millestr)
  417.    ELSE
  418.     BEGIN
  419.      Str(nr:3,millestr);
  420.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  421.     END;
  422.    helpstr:=helpstr+millestr;
  423.    n := Length(helpstr);
  424.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  425.  
  426.    FormattedIntStr := helpstr;
  427.   END;
  428. END;
  429.  
  430. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  431. (* Converts a long integer number into a string of the form xxx'xxx...') *)
  432.  
  433. VAR helpstr  : STRING;
  434.     millestr : STRING[4];
  435.     n,i      : WORD;
  436.  
  437. BEGIN
  438.  IF nr = 0 THEN FormattedLongIntStr := Chars(' ',minlength-1)+'0'
  439.  ELSE
  440.   BEGIN
  441.    helpstr := '';
  442.  
  443.    n := nr DIV 1000000; nr := nr MOD 1000000;
  444.    IF n > 0 THEN
  445.     BEGIN
  446.      Str(n,millestr); helpstr := millestr+MilleSep;
  447.     END;
  448.  
  449.    n := nr DIV 1000; nr := nr MOD 1000;
  450.    IF n > 0 THEN
  451.     BEGIN
  452.      Str(n,millestr);
  453.      IF helpstr > '' THEN
  454.       BEGIN
  455.        FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  456.        helpstr := helpstr+millestr+MilleSep;
  457.       END
  458.      ELSE helpstr := millestr+MilleSep;
  459.     END;
  460.  
  461.    IF n = 0 THEN Str(nr,millestr)
  462.    ELSE
  463.     BEGIN
  464.      Str(nr:3,millestr);
  465.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  466.     END;
  467.    helpstr:=helpstr+millestr;
  468.    n := Length(helpstr);
  469.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  470.  
  471.    FormattedLongIntStr := helpstr;
  472.   END;
  473. END;
  474.  
  475. (*------------------------------------------------------- Initialisation *)
  476.  
  477. PROCEDURE GetCountryInfo;
  478.  
  479. VAR Regs  : Registers;
  480.  
  481. BEGIN
  482.  WITH Regs DO
  483.   BEGIN
  484.    ah := $38; (* Get / Set Country Data *)
  485.    al := $00;
  486.    ds := Seg(Buffer); dx := Ofs(Buffer); (* Address of Buffer *)
  487.   END;
  488.  MsDos(Regs);
  489.  
  490.  IF Regs.Flags AND FCarry = 0 THEN
  491.   BEGIN
  492.    MilleSep := Buffer[ 7];
  493.    DateSep  := Buffer[11];
  494.    TimeSep  := Buffer[13];
  495.   END;
  496.  
  497.  CASE Ord(Buffer[0]) OF
  498.   0 : BEGIN
  499.        FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  500.        FormTime := FormTime12;       TimeFormat := 'hh'+TimeSep+'mmp';
  501.       END;
  502.   1 : BEGIN
  503.        FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  504.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  505.       END;
  506.   2 : BEGIN
  507.        FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  508.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  509.       END;
  510.  ELSE
  511.   BEGIN
  512.    FormDate := FormDateEuropean;     DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  513.    FormTime := FormTime24;           TimeFormat := 'hh'+TimeSep+'mm';
  514.   END;
  515.  END; (* CASE *)
  516. END;
  517.  
  518. PROCEDURE EvaluateINIFileSettings;
  519.  
  520. VAR s : STRING[7];
  521.  
  522. BEGIN
  523.  IF INIFileExists THEN
  524.   BEGIN
  525.    MilleSep := ReadSettingsChar('date & time formats','millesep',MilleSep);
  526.    TimeSep  := ReadSettingsChar('date & time formats','timesep' ,TimeSep);
  527.    DateSep  := ReadSettingsChar('date & time formats','datesep' ,DateSep);
  528.  
  529.    s := ReadSettingsString('date & time formats','dateformat','ddmmmyy');
  530.    IF s = 'ddmmyy' THEN
  531.     BEGIN
  532.      FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  533.     END
  534.    ELSE
  535.    IF s = 'mmddyy' THEN
  536.     BEGIN
  537.      FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  538.     END
  539.    ELSE
  540.    IF s = 'yymmdd' THEN
  541.     BEGIN
  542.      FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  543.     END
  544.    ELSE
  545.     BEGIN
  546.      FormDate := FormDateMyOwn;    DateFormat := 'ddmmmyy';
  547.     END;
  548.  
  549.    s := ReadSettingsString('date & time formats','timeformat','24');
  550.    IF s = '12' THEN
  551.     BEGIN
  552.      FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  553.     END
  554.    ELSE
  555.     BEGIN
  556.      FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  557.     END;
  558.   END;
  559. END;
  560.  
  561. BEGIN
  562.  GetCountryInfo;
  563.  IF INIFileExists THEN EvaluateINIFileSettings;
  564. END.
  565.